perm filename CRE[CRE,BGB]2 blob
sn#033841 filedate 1973-04-09 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 CRE - CART'S EYE - CONTOUR,REGION,EDGE - BGB 1973.
00005 00003 CRE DECLARATIONS.
00007 00004 INITIALIZATION - SA: AND REE:
00008 00005 CRE TTY LISTEN.
00011 00006 CRE COMMAND JUMP TABLE "A" THRU "Z".
00014 00007 SEGTV - GET OLD TVSEG.
00015 00008 KILLER & NEXIMG.
00017 00009 MAKE CUTS COMMAND "C".
00019 00010 MAKE CUTS COMMAND "Q".
00020 00011 AWIDTH - SELECT ARC WIDTH.
00023 00012 REALIN - REAL NUMBER INPUT FROM TTY.
00025 00013 MORCOR - GET MORE CORE.
00027 00014 SHRINK NODE SPACE.
00030 00015 SHRINK - CONTINUED.
00032 ENDMK
⊗;
;CRE - CART'S EYE - CONTOUR,REGION,EDGE - BGB 1973.
TITLE CRE
EXTERN QBLK,CAMERA,SX,SY,DEL,MAG
EXTERN DPYBLK,DPYIMG,DPYHIS,CROP
EXTERN MKCON,CREIN,CREOUT,BIMOD
EXTERN TVCAMI,TVXGP,PLOTO,XCART
INTERN FLGWED,FLGRAR,FLGU,FLGKRK,FLGBGB,FLGKIN
INTERN HISTO,TVBUF,VSEG,HSEG,PAC,HEADER
INTERN CTRL,META,CHR,VCUT
INTERN FTVSIX,FTVHIS
INTERN ARCWID,ROWPTR,COLPTR,REMAIN
;CONTROL FLAGS.
INTERN FLGSIX,FLGARC,FLGBK
FLGKRK:-1 ;ENABLE KRAKAUER TREE.
FLGSIX:-1 ;SIX BIT TELEVISON.
FLGARC:-1 ;ENABLE MAKE ARC SMOOTHING.
FLGBK:-1 ;ENABLE BABY KILLER.
VCUT:-14 ;VECTOR DISPLAY CONTRAST THRESHOLD.
FLGWED:0 ;DISPLAY WINGED EDGED IMAGE.
FLGBGB:0 ;RUNNING UNDER A BGB PPPN.
FLGRAR:1 ;DISPLAY RECIPROCAL ARC RADIALS.
;-1 BOTH, 0 VIC, +1 ARCS.
FLGKINK:0 ;DISPLAY KINKS.
FLGU:-1 ;KILVIC ENABLE.
;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
ARCWID:
FOR I←0,3{2.0↔}
FOR I←4,5{1.5↔}
FOR I←6,12{1.25↔}
FOR I←13,17{1.0↔}
FOR I←20,37{1.0↔}
FOR I←40,77{0.7↔}
0
SUBR(LOCKIN)
LAC[XWD 400017,.+3]↔SPCWGO↔POP0J↔HALT
DEFINE UNLOCK{043000636367}
;CRE DECLARATIONS.
;CAREYE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
;=10 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.
;=118 WORD TRAILER.
HI ←← 400000
$←400000
PAC ← HI ↔ HI ←← HI + =1728 ;PICTURE ACCUMULATOR.
VSEG← HI ↔ HI ←← HI + =1729 ;VERTICAL SEGMENTS.
HSEG← HI ↔ HI ←← HI + =1736 ;HORIZONTAL SEGMENTS.
HI ←← HI + =86 ;NEGATIVE ROWS.
HEADER←HI ↔ HI ←← HI + =10
TVBUF ←HI ↔ HI ←← HI + =10368 ;TV BUFFER 6 BITS PER PIXEL.
HI ←← HI + =54 ;FREE SPACE.
HISTO ←HI ↔ HI ←← HI + =64 ;HISTOGRAM.
FTVSIX←HI ↔ HI ←← HI + 1 ;FLAG TV SIX BIT.
FTVHIS←HI ↔ HI ←← HI + 1 ;FLAG TV HISTOGRAM PRESENT.
;POINTERS TO TV SEGMENT.
TV: 0
POINT 6,-1,29 ;COLUMN -2.
POINT 6,-1,35 ;COLUMN -1.
COLPTR: FOR I←0,=48{
I+<POINT 6,0,05>↔I+<POINT 6,0,11>↔I+<POINT 6,0,17>
I+<POINT 6,0,23>↔I+<POINT 6,0,29>↔I+<POINT 6,0,35>}
ROWPTR: FOR I←0,=216{
I*=48+TVBUF}
TVSEG: 0
;INITIALIZATION - SA: AND REE:
;----------------------------------------------------------------
PDL: BLOCK 100
;START ADDRESS
SA: LAC 17,[IOWD 100,PDL]
CALL(MORCOR)
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
PPIOT 2,-=250
PPIOT 3,3003
MOVEI 20↔CRLF↔SOJG .-1
SETZ↔GETPPN↔CDR
CAIN'BGB'↔SETOM FLGBGB
LAC 17,[IOWD 100,PDL]
CALL(CROP)
CALL(DPYIMG)
PUSHJ TTY
EXIT
;6/12/72----------------------------------------------------------
;TELETYPE COMMAND STATE.
DECLARE{CTRL,META,CHR}
;CRE TTY LISTEN.
SUBR(TTY)---------------------------------------------------------
BEGIN TTY;CAREYE TELETYPE COMMAND JUMP TABLE -BGB- NOVEMBER 1972.
L0: CRLF
L1: OUTCHR["*"]
INCHRW
SETZM CTRL↔TRZE 200↔SETOM CTRL
SETZM META↔TRZE 400↔SETOM META
CAIN 0,15↔GO L1+1
CAIN 0,12↔GO L1
DAC 0,CHR
;TEST FOR LETTER COMMAND.
LAC 1,0↔ANDI 1,37
CAIGE 0,"A"↔GO .+3
CAIG 0,"Z"↔GO L3
CAIGE 0,"a"↔GO .+3
CAIG 0,"z"↔GO L3
;WINDOW MOVING COMMANDS.
CAIN 0," "↔GO L2
CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
;QBLK CHANGING COMMANDS.
CAIN 0,"!"↔GO[SETZ 1,↔GO L2B+1]
CAIN 0,"⊗"↔GO[LAC 1,FILM↔GO L2B+1]
CAIN 0,"+"↔GO[LAC 1,FILM↔GO L2B+1]
CAIN 0,","↔GO[SKIPE 1,QBLK↔CW 1,1↔GO L2B]
CAIN 0,"."↔GO[SKIPE 1,QBLK↔CCW 1,1↔GO L2B]
CAIN 0,"↓"↔GO[SKIPE 1,QBLK↔ENDO 1,1↔GO L2B]
CAIN 0,"↑"↔GO[SKIPE 1,QBLK↔EXO 1,1↔GO L2B]
CAIN 0,"↔"↔GO[SKIPE 1,QBLK↔ARC 1,1↔GO L2B]
CAIN 0,"≥"↔GO[SKIPE 1,QBLK↔PED 1,1↔GO L2B]
CAIN 0,"≤"↔GO[SKIPE 1,QBLK↔NED 1,1↔GO L2B]
CAIN 0,"<"↔GO[SKIPE 1,QBLK↔NCCW 1,1↔GO L2B]
CAIN 0,">"↔GO[SKIPE 1,QBLK↔SON 1,1↔GO L2B]
CAIN 0,"→"↔GO[SKIPE 1,QBLK↔PGON 1,1↔GO L2B]
CAIN 0,"←"↔GO[SKIPE 1,QBLK↔NGON 1,1↔GO L2B]
CAIN 0,"⊂"↔GO[SKIPE 1,QBLK↔NTIME 1,1↔GO L2B]
CAIN 0,"⊃"↔GO[SKIPE 1,QBLK↔PTIME 1,1↔GO L2B]
CAIN 0,"6"↔GO[SETOM FLGSIX↔SETOM FTVSIX↔GO L1]
CAIN 0,"4"↔GO[SETZM FLGSIX↔SETZM FTVSIX↔GO L1]
GO L0
L2: CALL(CROP)↔CALL(DPYIMG)↔GO L1+1
L2B: SKIPE 1↔DAC 1,QBLK↔CALL(DPYBLK)↔GO L1+1
;CRE COMMAND JUMP TABLE "A" THRU "Z".
L3: PUSHJ P,@L4(1)↔GO L1
L4: NOP ;null.
FLGA. ;"A" ARC MAKE FLAG.
XCART; *;"B" DRIVE BACKWARDS.
MAKCUT ;"C" MAKE THRESHOLD CUT.
FLGB. ;"D" DELETE BABY POLYGONS.
FLGE. ;"E"
XCART; *;"F" DRIVE FORWARDS.
NOP ;"G"
DPYHIS ;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
CREIN ;"I" INPUT.
BIMOD ;"J" TWO CUTS AT 3% FROM ENDS.
FLGK. ;"K" KRAKAUER FLAG.
XCART; *;"L" TURN LEFT. "αL" PAN CAMERA LEFT.
NOP ;"M"
NEXIMG ;"N" IMAGE RETREAT.
CREOUT ;"O" OUTPUT.
PLOTO ;"P" PLOT OUTPUT FILE.
MKCUTS ;"Q" EQUI-SPACED CUTS.
XCART; *;"R" TURN RIGHT. "αR" PAN CAMERA RIGHT.
CAMERA ;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.
TVCAMI ;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
FLGU. ;"U"
XCART ;"V" XCART DIAGONOSTIC COMMAND MODE.
AWIDTH ;"W" SET ARC WIDTH TABLE.
TVXGP ;"X" XEROX OUTPUT.
FLGR. ;"Y" DISPLAY RECIPROCAL ARC RADIALS.
KILLER ;"Z" ZERO DATA BUFFERS.
NOP: CRLF
POP0J
FLGA.: SETCMM FLGARC↔CRLF↔POP0J
FLGB.: SETCMM FLGBK ↔CRLF↔POP0J
FLGE.: SETCMM FLGWED↔CALL(DPYIMG)↔CRLF↔POP0J
FLGK.: SETCMM FLGKRK↔CRLF↔POP0J
FLGU.: SETCMM FLGU↔CRLF↔POP0J
FLGR.: SETZM FLGWED
LAC CTRL↔AND META
JUMPN[SETOM FLGKINK↔GO .+8]↔SETZM FLGKINK
LACI 1↔DAC FLGRAR
SKIPE CTRL↔SETOM FLGRAR
SKIPE META↔SETZM FLGRAR
CALL(DPYIMG)↔CRLF↔POP0J
LIT
BEND;12/8/72------------------------------------------------------
;SEGTV - GET OLD TVSEG.
SUBR(SEGTV)-------------------------------------------------------
;GET THE OLD TVSEG.
SETZ↔SEGNUM
SKIPE 1,TVSEG
GO[ CAMN 0,1↔POP0J↔SKIPE↔DETSEG
ATTSEG 1,↔GO[FATAL(TVSEG ATTACH FAILURE.)]↔POP0J]
SKIPE↔DETSEG
;MAKE A NEW TVSEG.
LACI HI
CORE2↔GO[FATAL(AIN'T NO CORE UP YONDER.)]
LAC[SIXBIT/TVSEG/]↔SETNM2↔JFCL
SETZ↔SEGNUM↔DAC TVSEG
LAC[XWD $,$+1]↔SETZM $↔BLT HI-1
LAC[XWD HEAD,HEADER]↔BLT HEADER+9
POP0J
;OLDE TEN WORD TV PICTURE HEADER.
HEAD: 7↔0↔6↔=288↔=48↔=20↔=235↔=28↔=315↔=10368
;16/12/72---------------------------------------------------------
;KILLER & NEXIMG.
SUBR(KILLER)------------------------------------------------------
BEGIN KILLER
SKIPE CTRL↔GO L
SETZM QBLK
LAC OLD44↔CORE↔JFCL↔SETZM OLD44
SETZM AVAIL↔SETZM BLKCNT↔SETZM FILM
CALL(MORCOR)
L: SETZM SX↔SETZM SY
LAC[32.0]↔DAC DEL
LAC[3.4]↔DAC MAG
CALL(CROP)
CALL(DPYIMG)
CRLF↔POP0J
BEND;12/31/72-----------------------------------------------------
SUBR(NEXIMG)------------------------------------------------------
BEGIN NEXIMG;NEXT IMAGE - BGB - 11 DEC 72.
SKIPA
SETOM CTRL
LAC 1,FILM
SON 2,1
CDR 3,(2)↔SKIPE CTRL↔CAR 3,(2)
SON. 3,1
CALL(DPYIMG)
SKIPE META↔GO[INCHRS↔GO NEXIMG↔GO .+1]
CRLF
POP0J
BEND;12/11/72-----------------------------------------------------
;MAKE CUTS COMMAND "C".
SUBR(MAKCUT)------------------------------------------------------
BEGIN MAKCUT; MAKE CUTS "C" COMMAND.
;CONTRAST DISPLAY CUT OFF COMMANDS.
SKIPE META↔GO[MOVNS VCUT↔CALL(DPYIMG)↔POP0J]
SKIPE CTRL↔GO[INCHRW↔ANDI 7↔LSH 3
INCHRW 1↔ANDI 1,7↔IOR 0,1↔DAC VCUT↔CALL(DPYIMG)↔POP0J]
;MAKE CUT COMMAND BEGINS HERE.
SETZM QQ2↔SETZM QQ3
L1: SETZ 1,↔INCHWL
CAIN 15↔GO[CALL(L3)↔GO L2]
CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L3)↔GO L1]
IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1
L2: INCHWL
CALL(MKCON,QQ2,QQ3)↔CALL(DPYIMG)↔CALL(SHRINK)
POP0J
DECLARE{QQ2,QQ3}
L3: SKIPN 1↔POP0J
CAIL 1,=64↔POP0J
MOVNS 1↔SETZ 3,
SLACI 2,1B18↔LSHC 2,(1)
IORM 2,QQ2↔IORM 3,QQ3
POP0J
LIT
BEND;1/17/73------------------------------------------------------
;MAKE CUTS COMMAND "Q".
SUBR(MKCUTS)------------------------------------------------------
BEGIN MKCUTS; MAKE CUTS Q-COMMAND - BGB - 9 DEC 1972.
SETZ 1,
SKIPE CTRL↔LACI 1,1
SKIPE META↔ADDI 1,2
PUSH P,Q1(1)
PUSH P,Q2(1)
CALL(MKCON)
CALL(SHRINK)
CALL(DPYIMG)
POP0J
;THREE, SEVEN, EIGHT OR FIFTEEN CUTS - EQUALLY SPACED.
Q1: 1B16 +1B32
1B8+1B16+1B24+1B32 ↔ 1B4+1B12+1B20+1B28
1B8+1B16+1B24+1B32 + 1B4+1B12+1B20+1B28
Q2: 1B12
1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
1B4+1B12+1B20 + 1B0+1B8+1B16+1B24
BEND MKCUTS;BGB 9 DECEMBER 1972------------------------------------
;AWIDTH - SELECT ARC WIDTH.
SUBR(AWIDTH)------------------------------------------------------
BEGIN AWIDTH
ACCUMULATORS{DEL,XLO,XHI,X1,X2}
TDCA X2,X2↔INCHWL
L1: OUTSTR[ASCIZ/ #/]
INCHRW↔CAIN 15↔GO L1-1
CAIL"0"↔CAILE"7"↔GO L4
ANDI 7↔LSH 3↔DAC 1
INCHRW↔CAIN 15↔GO L1-1
CAIL"0"↔CAILE"7"↔GO L4
ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1
L2: CALL(TYPOUT)
CALL(REALIN)
JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
CAIE 1,12↔GO .+3↔OUTCHR[15]↔AOJA X2,L3
CAIN 1,15↔INCHWL
CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
L3: CAILE X2,77↔LACI X2,77
CAIGE X2,00↔LACI X2,00
LAC[ASCIZ/ #00/]
DPB X2,[POINT 3,0,27]↔ROT X2,-3
DPB X2,[POINT 3,0,20]↔ROT X2, 3
OUTSTR↔GO L2
L4: CRLF↔POP0J
TYPOUT: LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
IDIVI 0,=1000
SKIPE↔IORI"0"↔IORI" " ↔DPB 0,[POINT 7,STR,13]
IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
IDIVI 2,=10 ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
OUTSTR STR↔POP0J
STR: ASCIZ/ 99.99 /
ALTER: DAC ARCWID(X2)
LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
LAC XHI↔SUB XLO↔FLOAT
LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
LAC ARCWID(XLO)↔AOS XLO
L5: CAML XLO,XHI↔POP0J
FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5
BEND AWIDTH;BGB 16 DECEMBER 1972 ---------------------------------
;REALIN - REAL NUMBER INPUT FROM TTY.
SUBR(REALIN)------------------------------------------------------
BEGIN REALIN
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
SETZ↔SETZB 2,3
L1: INCHWL 1
CAIE 1,"-"↔GO .+3↔SETCMM 3↔GO L1
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
SKIPE 3↔MOVNS↔POP0J
BEND REALIN; 16 DECEMBER 1972 ------------------------------------
;MORCOR - GET MORE CORE.
INTERN OLD44,FILM,BLKCNT,AVAIL
OLD44: 0
FILM: 0
BLKCNT: 0
AVAIL: 0
REMAINDER:0
NODSIZ←←7
SUBR(MORCOR)------------------------------------------------------
BEGIN MORCOR
;INITIALIZE FILM BLOCK POINTERS WHEN NECESSARY.
SKIPE OLD44↔GO L1
LAC 1,44↔DAC 1,OLD44
AOS 1↔DAC 1,FILM
ADDI 1,3↔DAC 1,AVAIL
AOS 1↔DAC 1,BLKCNT
SETZM REMAINDER
;FOUR MORE K !
L1: LAC 1,44↔LAC 0,1↔ADDI 0,10000
CALLI 11↔GO[FATAL(NO MORE CORE.)]
AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ,0]
SKIPE@BLKCNT↔GO .+3
ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT
DAPZ 1,@AVAIL
L2: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
LACI 10000↔ADDM @FILM
LAC 1,FILM↔LAC[FILBIT+010000]↔DAC 2(1)
LAC 1,@AVAIL
LAC 2,AC2↔POP0J
BEND MORCOR; BGB 4 DECEMBER 1972 ---------------------------------
;SHRINK NODE SPACE.
SUBR(SHRINK)------------------------------------------------------
BEGIN SHRINK;SHRINK NODE SPACE - BGB - 17 JANUARY 1973.
ACCUMULATORS{A,HOLE,BREAK,NODE}
LAC@BLKCNT↔IMULI NODSIZ↔ADD FILM
DAC BREAK↔LACI NODE,-NODSIZ(BREAK)↔SKIPA HOLE,FILM
;FIND A HOLE BELOW THE BREAK.
L1: ADDI HOLE,NODSIZ↔CAML HOLE,BREAK↔GO L3
TYPE 0,HOLE↔JUMPN 0,L1
;FIND A NODE ABOVE THE BREAK.
L2: ADDI NODE,NODSIZ
CAML NODE,44↔GO[FATAL({SHRINK - NODE CNT TOO BIG.})]
TYPE 0,NODE↔JUMPE 0,L2
;MOVE THE NODE INTO THE HOLE.
DIP NODE,0↔DAP HOLE,0
BLT 0,NODSIZ-1(HOLE)
DAPZ HOLE,0(NODE) ;NODE'S NEW LOCATION.
GO L1
;SHRINK - CONTINUED.
;REPLACE LINKS ABOVE THE BREAK WITH THEIR NEW VALUES.
DEFINE KAR(Q){
CAR 1,Q(A)
CAML 1,BREAK↔LAC 1,0(1)
DIP 1,Q(A)↔GO .+1}
DEFINE KDR(Q){
CDR 1,Q(A)
CAML 1,BREAK↔LAC 1,0(1)
DAP 1,Q(A)↔GO .+1}
L3: LAC A,FILM ;BLOCK POINTER.
L4: RELOC 0,A↔TRNE 400000↔LACI 333333
TRNE 200000↔GO[KAR 0]↔ TRNE 100000↔GO[KDR 0]
TRNE 20000 ↔GO[KAR 1]↔ TRNE 10000 ↔GO[KDR 1]
TRNE 2000 ↔GO[KAR 3]↔ TRNE 1000 ↔GO[KDR 3]
TRNE 200 ↔GO[KAR 4]↔ TRNE 100 ↔GO[KDR 4]
TRNE 20 ↔GO[KAR 5]↔ TRNE 10 ↔GO[KDR 5]
TRNE 2 ↔GO[KAR 6]↔ TRNE 1 ↔GO[KDR 6]
ADDI A,NODSIZ↔CAMGE A,BREAK↔GO L4
;SHRINK CORE SIZE AND RESET AVAIL LIST.
LAC 0,BREAK↔IORI 0,1777↔CALLI 0,11↔HALT ;SHRINK CORE.
LAC 1,BREAK↔LAC 2,44↔DAPZ 1,@AVAIL ;NEW BOUNDS.
LACI 0,1(1)↔DIP 1,0↔SETZM(1)↔BLT(2) ;CLEAR AVAILS.
LACI 1(2)↔SUB FILM↔DAC@FILM ;NEW CORE SIZE.
LIPI 1,NODSIZ(1)↔GO L6
L5: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
L6: CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER↔POP0J
LIT
BEND;1/17/73------------------------------------------------------
END SA